home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / bbs / diebox19 / fstat.pas < prev    next >
Pascal/Delphi Source File  |  1992-10-14  |  9KB  |  373 lines
  1. { Ausgabe eine Auslesestatistik fuer DIEBOX anhand von RLOG.BOX }
  2. { Version 0.3 - DL1MCX @ OE9XPI }
  3.  
  4. Program FStat;
  5. Uses Crt, Dos;
  6.  
  7. Const
  8.   MaxDir = 4096;
  9.   NoError = 0;
  10.   OpenError = 1; FormatError = 2;
  11.  
  12. Type
  13.   AnyStr     = String[255];
  14.   DirRec     = Record
  15.                  DosFile : String[14];
  16.                  count   : Word;
  17.                End;
  18.  
  19.   DirPtr     = ^DirRec;
  20.   DirArr     = Array[1..MaxDir] of DirPtr;
  21.  
  22.   LessFunc = function(X, Y: DirPtr):Boolean;
  23.  
  24. Var
  25.   Con,
  26.   RFile        : Text;
  27.   UserPfad,
  28.   InfoPfad,
  29.   SysPfad      : String;
  30.   LogBegin,
  31.   LogEnd,
  32.   filename,
  33.   datum,
  34.   bytecount,
  35.   absender,
  36.   titel        : AnyStr;
  37.   returncode   : byte;
  38.   Dir          : DirArr;
  39.   Count,RCount : Word;
  40.   Less         : LessFunc;
  41.   DisplCount   : Word;
  42.  
  43. {-------------------------------------------------------------------------
  44.  ConstStr  fuellt einen String auf die Gesamtlaenge L mit Zeichen ch auf;
  45.           Fuer Posi wird "r" oder "l" erwartet (rechts- oder linksbuendig)
  46. --------------------------------------------------------------------------}
  47. FUNCTION ConstStr (Zeile:String; L:Integer; ch, Posi:Char) : String;
  48. Var B_Str : String;
  49. Laenge    : Byte;
  50. BEGIN
  51.   Laenge := L - length(Zeile);
  52.   IF (L < 0 ) THEN L := 0;
  53.   IF (L > 255) THEN L := 255;
  54.   fillchar(B_Str,Laenge+2,ch);
  55.   B_Str[0] := Chr(Laenge);
  56.  
  57.   If Posi = 'l'
  58.     then ConstStr  := Zeile + B_Str;
  59.   IF Posi = 'r'
  60.     then ConstStr  := B_Str + Zeile;
  61. END;
  62.  
  63. {------------------------------------------------------------------------------
  64.  isCall prüft, ob RUBRIK ein Call oder 'ne Rubrik ist
  65. +-----------------------------------------------------------------------------}
  66. FUNCTION isCall (Rubrik : String ): Boolean;
  67. const
  68.   digit = ['0'..'9'];
  69.  
  70. var
  71.   i      :  shortint;
  72.   ok     :  boolean;
  73.   count  :  shortint;
  74.   suffix :  shortint;
  75.  
  76. begin
  77.  
  78.   ok     := false;
  79.   suffix := 0;
  80.   count  := length (Rubrik);
  81.   if count in [2..7]
  82.   then
  83.  
  84.     for i:=1 to 3 do
  85.     begin
  86.       if    ( Rubrik [i] in digit )
  87.         and ( i in [2,3] )
  88.       then ok := true
  89.     end;
  90.  
  91.     if ok then
  92.       if ( Rubrik [1] in digit ) and
  93.          ( Rubrik [2] in digit )
  94.        then ok := false;       (* keine Calls mit 2 führenden Ziffern *)
  95.  
  96.     if ok then
  97.     for i:=count downto 1 do
  98.       if     not ( Rubrik [i] in digit )
  99.       then inc (suffix);
  100.  
  101.   if ok and ( suffix < 5 ) then
  102.     if not ( Rubrik [count] in digit )  then
  103.       ok := true
  104.     else ok := false;
  105.  
  106.   isCall := ok;
  107. end;
  108.  
  109. {-----------------------------------------------------------------------
  110.  Sortierfunktionen
  111.  -----------------------------------------------------------------------}
  112. {$F+}
  113.  
  114. (* numerisch sortieren *)
  115. function MoreCount(X, Y : DirPtr): Boolean;
  116. begin
  117.   MoreCount := X^.Count > Y^.Count;
  118. end;
  119.  
  120. {$F-}
  121.  
  122. {----------------------------------------------------------------------
  123.  QuickSort  Sortieralgorithmus
  124.  ----------------------------------------------------------------------}
  125. procedure QuickSort(L, R: Integer);
  126. var
  127.   I, J: Integer;
  128.   X, Y: DirPtr;
  129.   Z   : DirPtr;
  130. begin
  131.   I := L;
  132.   J := R;
  133.   X := Dir[(L + R) div 2];
  134.   repeat
  135.     while Less(Dir[I], X) do Inc(I);
  136.     while Less(X, Dir[J]) do Dec(J);
  137.     if I <= J then
  138.     begin
  139.       Y := Dir[I];
  140.       Dir[I] := Dir[J];
  141.       Dir[J] := Y;
  142.       Inc(I);
  143.       Dec(J);
  144.     end;
  145.   until I > J;
  146.   if L < J then QuickSort(L, J);
  147.   if I < R then QuickSort(I, R);
  148. end;
  149.  
  150. {------------------------------------------------------------------------------
  151.  Take_Pfad  liefert einen String mit dem kompl. Pfad zu den INFO- / USER-Files
  152. +-----------------------------------------------------------------------------}
  153. PROCEDURE Take_Pfad(Var UserPfad, InfoPfad, SysPfad : String);
  154. Var  i         : Shortint;
  155.      Zeile     : String;
  156.      ConfigBox : Text;
  157. BEGIN
  158.   ASSIGN(ConfigBox,'CONFIG.BOX');
  159.   {$I-} RESET(ConfigBox); {$I+}    (* Config.Box oeffnen um Pfad zu holen *)
  160.   IF IOResult <> 0
  161.    then
  162.      begin
  163.        writeln(Con,#13#10'Fehler beim Öffnen von CONFIG.BOX');
  164.        close(con);
  165.        halt;
  166.      end
  167.    else
  168.      begin
  169.        For i:=1 to 36 Do Readln(ConfigBox,Zeile);
  170.        UserPfad := Copy(Zeile,1,(i-1));
  171.        Readln(ConfigBox,Zeile);
  172.        InfoPfad := Copy(Zeile,1,(i-1));
  173.        Readln(ConfigBox,Zeile);
  174.        SysPfad  := Copy(Zeile,1,(i-1));
  175.        CLOSE(ConfigBox);
  176.      end;
  177. END;
  178.  
  179. {-----------------------------------------------------------------------
  180.  Lesen des Boxfileheaders
  181.  -----------------------------------------------------------------------}
  182. FUNCTION GetBoxfileInfo (BoxFile : AnyStr): ShortInt;
  183. var
  184.   Zeile1,
  185.   Zeile2  : AnyStr;
  186.   dummy   : char;
  187.   i       : integer;
  188.   bf      : Text;
  189.  
  190. begin
  191.   GetBoxfileInfo := noerror;
  192.   assign(bf,BoxFile);
  193.   {$I-} Reset(bf); {$I+}
  194.   if IOResult <> 0
  195.     then GetBoxfileInfo := openerror
  196.     else
  197.       begin
  198.         GetBoxfileInfo := noerror;
  199.         Readln(bf,Zeile1);
  200.         Readln(bf,Zeile1);
  201.         Readln(bf,Zeile2);
  202. (*
  203. SP @DL           de:DF5QF  07.09.92 20:15  10   1931 Bytes
  204. Autodo - Hilfe ?
  205. *** Bulletin-ID: 079209DB0BQ ***
  206. *** Received from OE9XPI ***
  207. *)
  208.         Absender := Copy(Zeile1,22,6);
  209.         Filename := Copy(Zeile1,2,(Pos(' ',Zeile1)-1));
  210.         Datum := Copy(Zeile1,29,14);
  211.         ByteCount := Copy(Zeile1,48,6);
  212.         titel := Copy(Zeile2,1,80);
  213.         close(bf);
  214.       end;
  215. end;
  216.  
  217. {--------------
  218.  GetDisplayCount
  219.  --------------}
  220. Procedure GetDisplayCount;
  221. Var
  222.   e: Integer;
  223.  
  224. Begin
  225.   If ParamCount = 1 then
  226.     Val(ParamStr(1),DisplCount,e)
  227.   else
  228.     DisplCount := 50;
  229.   If DisplCount > Count then DisplCount := Count;
  230. End;
  231.  
  232. {-------------------------
  233.  OpenRFile oeffnet LogFile
  234.  -------------------------}
  235. Function OpenRFile : Byte;
  236. Begin
  237.   ASSIGN(RFile,'\PROTO\RLOG.BOX');
  238.   {$I-} RESET(RFile); {$I+}
  239.   IF IOResult <> 0
  240.     then OpenRFile := OpenError
  241.   else
  242.     OpenRFile := noerror;
  243. End;
  244.  
  245. {-------------------------------------
  246.  ReadRFile liest Daten aus Logfile ein
  247.  -------------------------------------}
  248. Procedure ReadRFile;
  249. Var
  250.   i,z   : Word;
  251.   Zeile : AnyStr;
  252.   Board : String[12];
  253.   DosFile : String[16];
  254.   found : boolean;
  255.  
  256. Begin
  257.   i := 0;
  258.   While (not EOF(RFile) and (i < MaxDir)) do
  259.     begin
  260.       Readln(RFile,Zeile);
  261.     
  262. (*
  263.  1 22.06.92 00:18 DL1MCX: IBM         1 ZBPKNL
  264. *)
  265.       if i = 0 then LogBegin := Copy(Zeile,4,14);
  266.       Board := Copy(Zeile,27,9);
  267.       Board := Copy(Board,1,Pos(' ',Board)-1);
  268.       If (not(iscall(Board)) and (length(Board) > 1)) then
  269.         begin
  270.           DosFile := Board + Copy(Zeile,41,6);
  271.           found := false;
  272.           z := 1;
  273.           While ((z <= i) and (not found)) do
  274.             begin
  275.               If Dir[z]^.DosFile = DosFile then
  276.                 begin
  277.                   found := true;
  278.                   inc(Dir[z]^.count);
  279.                 end;
  280.               inc(z);
  281.             end;
  282.           If (not found) then
  283.             begin
  284.               inc(i);
  285.               If (MaxAvail < SizeOf(DirRec))
  286.               then
  287.                 begin
  288.                   Writeln(Con,#13#10'Nicht genügend Speicher, Programm abgebrochen');
  289.                   close(RFile);
  290.                   close(con);
  291.                   halt;
  292.                 end
  293.               else
  294.                 begin
  295.                   New(Dir[i]);
  296.                   Dir[i]^.DosFile := DosFile;
  297.                   Dir[i]^.count := 1;
  298.                 end;
  299.             end;
  300.  
  301.           end;
  302.     End;
  303.     LogEnd := Copy(Zeile,4,14);
  304.     Count := i;
  305.     if (i = MaxDir) then
  306.       writeln(con,#13#10'Speichermangel - Daten unvollständig !');
  307.   Close(RFile);
  308. End;
  309.  
  310. {------------------------
  311.  WriteStat gibt Liste aus
  312.  ------------------------}
  313. Procedure WriteStat;
  314. Var
  315.   i             : Word;
  316.   Board         : String[8];
  317.   DosFile       : String[6];
  318.   CountStr      : String[5];
  319.   Zeile,
  320.   ProtfilePath,
  321.   Outline       : AnyStr;
  322.   found         : boolean;
  323.  
  324. Begin
  325.   For i := 1 to DisplCount do
  326.     begin
  327.       found := false;
  328.       Zeile := Dir[i]^.DosFile;
  329.       Board := Copy(Zeile,1,length(Zeile)-6);
  330.       ProtfilePath := InfoPfad + Board;
  331.       DosFile := Copy(Zeile,length(Zeile)-5,6);
  332.       returncode := GetBoxfileInfo(ProtfilePath + '\' + DosFile);
  333.       if returncode = noerror then
  334.       begin
  335.         found := true;
  336.         Str(Dir[i]^.Count,CountStr);
  337.         Outline := ConstStr(CountStr,5,' ','r') + ' '
  338.         + ConstStr(Board,8,' ','l') + ' < ' + Absender +  ' ' + Datum + ' ' +
  339.         + bytecount + ' ' + Copy(titel,1,33);
  340.         Writeln(Con,Outline);
  341.       end;
  342.       if(not found) then
  343.         begin
  344.           Outline := ConstStr(CountStr,5,' ','r') + ' '
  345.           + ConstStr(Board,8,' ','l');
  346.           Writeln(Con,Outline);
  347.         end;
  348.   end;
  349. End;
  350.  
  351. Begin
  352.   DirectVideo := False;
  353.   RCount := 0;
  354.   Less := MoreCount;
  355.   ASSIGN(Con,'');
  356.   REWRITE(Con);
  357.   Write(Con,#13#10'FStat v0.3 (DL1MCX)');
  358.   Take_Pfad(UserPfad,InfoPfad,Syspfad);
  359.   Returncode := OpenRFile;
  360.   if Returncode = noerror then
  361.     begin
  362.       ReadRFile;
  363.       GetDisplayCount;
  364.       Writeln(Con,' - Statistik vom ',Logbegin,' bis ',LogEnd,#13#10);
  365.       Writeln(Con,'Count File       Call   Datum    Zeit   Bytes Titel'#13#10);
  366.       quicksort (1,Count);
  367.       WriteStat;
  368.     end;
  369.   Writeln(Con);
  370.   Close(Con);
  371. End.
  372.  
  373.